Amiga Collections: Scope/Scope Disk #078 (199x)(Scope PD)(US)[WB].zip/Scope Disk #078 (199x)(Scope PD)(US)[WB].adf/SD/sd.mod

Text File | 1989-06-29 | 11KB | 454 lines

MODULE SD;

FROM Path    IMPORT    PathName;
FROM printf     IMPORT     printf;
FROM SYSTEM    IMPORT    ADR, ADDRESS, LONGWORD;
FROM System    IMPORT    argc,argv;
FROM AmigaDOS    IMPORT    FileHandle, FileLock, Lock, UnLock,
            AccessRead, Examine, ExNext, CurrentDir,
            FileInfoBlockPtr, IoErr, ErrorNoMoreEntries,
            SigBreakCtrlC, BPTR, BSTR, Input, Read;
FROM AmigaDOSExt    IMPORT    CommandLineInterfacePtr;
FROM AmigaDOSProcess    IMPORT    ProcessPtr;
FROM Memory    IMPORT    AllocMem, FreeMem, MemReqSet, MemPublic;
FROM Strings    IMPORT    CopyString, ConcatString, StringLength,
            CompareStringCAP, LocateSubString,
            ConvStringToUpperCase, equal;
FROM Tasks    IMPORT    TaskPtr, FindTask, CurrentTask;


(*$D-*)

CONST
    Version = '1.01c';
    ClearLine = '\r\x9B\x4B\r';
    InvalidDeviceErr = '\r\x9B\x4B\r%s is not a valid device or directory.\n';
    ExamineErr = '\r\x9B\x4B\r***ERROR in Examine()\n';
    BreakErr = '\r\x9B\x4B\r *** BREAK ***\n';
    MemErr = '\r\x9B\x4B\r***ERROR in allocating memory.\n';
    LockErr = "\r\x9B\x4B\rCan't find %s\n";
    GeneralErr = '\r\x9B\x4B\r***ERROR\n';


TYPE
    DirEntry = POINTER TO DirEntryRecord;

    DirEntryRecord = RECORD
        DirName : ARRAY [0..30] OF CHAR;
        next : DirEntry;
    END;

VAR
    fib : FileInfoBlockPtr;
    mytask : TaskPtr;
    processptr : ProcessPtr;
    cliptr      : CommandLineInterfacePtr;
    dirname : ARRAY [0..255] OF CHAR;
    basename : ARRAY [0..30] OF CHAR;
    pattern : ARRAY [0..30] OF CHAR;
    null : ARRAY [0..0] OF CHAR;
        found,dirtype : BOOLEAN;
    exactset : BOOLEAN;
    arg : LONGWORD;

PROCEDURE Usage();
BEGIN
    arg := ADR(Version);
    printf('   Usage:  SD {device|directory|root}\n\
\   Usage:  SD {pattern} [ON] {device|directory|root}\n\n\
\t\33[33mS\33[m[earch] for \33[33mD\33[m[irectory]\n\
\tIdentical to AmigaDOS CD command with an option to\n\
\tsearch for a pattern.\n\n\
\tBy David Czaya\t1988-Sept\n',arg);
    HALT;
END Usage;


PROCEDURE CtrlC(): BOOLEAN;
BEGIN
    RETURN SigBreakCtrlC IN mytask^.tcSigRecvd
END CtrlC;


PROCEDURE Cleanup();
BEGIN
    IF CtrlC() THEN
         printf(BreakErr,arg);
    END;

    FreeMem(fib,SIZE(fib^));
    HALT;
END Cleanup;


PROCEDURE MPTR(bptr: BPTR): ADDRESS;
BEGIN
    RETURN ADDRESS(bptr) * 4D;
END MPTR;


PROCEDURE matched(base,pattern: ARRAY OF CHAR; exact: BOOLEAN): BOOLEAN;
VAR
    str1,str2 : ARRAY [0..30] OF CHAR;
BEGIN
    IF NOT exact THEN
        CopyString(str1,base);        (* we don't want to damage the *)
        CopyString(str2,pattern);    (* originals, so we work on copies *)
        ConvStringToUpperCase(str1);
        ConvStringToUpperCase(str2);

        RETURN (LocateSubString(str1,str2,0,StringLength(str1)) # -1);
    END;
    RETURN (CompareStringCAP(pattern,base) = equal);
END matched;


PROCEDURE IsDevice(str: ARRAY OF CHAR): BOOLEAN;
VAR
    char : CHAR;
BEGIN
    char := str[StringLength(str)-1];
    RETURN ((char = ':') OR (char = '/'));
END IsDevice;


PROCEDURE IsDir(fib: FileInfoBlockPtr): BOOLEAN;
BEGIN
    RETURN (fib^.fibDirEntryType > 0D);
END IsDir;


(*$D+*)
PROCEDURE TackOn(VAR FullPathName: ARRAY OF CHAR;
             ParentDir,DirName: ARRAY OF CHAR);
BEGIN
    CopyString(FullPathName,ParentDir);

    IF NOT IsDevice(FullPathName) THEN
        ConcatString(FullPathName,'/');
    END;

    ConcatString(FullPathName,DirName);
END TackOn;


PROCEDURE SetPathName(pathptr: ADDRESS; dirname: ARRAY OF CHAR);
CONST
    max = 80;

    PROCEDURE CSTRtoBSTR(VAR bstr: ADDRESS;
                     cstr: ARRAY OF CHAR;
                     maxlen: CARDINAL);
    (* convert a Modula-2 (C) type string to address of BCPL string
       path = ADDRESS of BSTR
       pathname = Modula-2 type string array
       maxlen = max length of the BSTR including length bytes  *)

    VAR
        ptr : POINTER TO CHAR;
        len,pos : CARDINAL;
    BEGIN
            ptr := bstr;
        len := StringLength(cstr);
            ptr^ := CHAR(len);

            pos := 0;
        REPEAT
        INC(ADDRESS(ptr));
        ptr^ := cstr[pos];
        INC(pos);
            UNTIL (pos = len) OR (pos = maxlen-1);
    END CSTRtoBSTR;

BEGIN
    CSTRtoBSTR(pathptr,dirname,max);
END SetPathName;


PROCEDURE GetCurrentDir(VAR dest: ARRAY OF CHAR): ADDRESS;
VAR
    pathptr : ADDRESS;

    PROCEDURE BSTRtoCSTR(VAR cstr: ARRAY OF CHAR; bstr: ADDRESS);
       (* convert BCPL string to a Modula-2 (C) type string
       bstr = ADDRESS of BSTR
       cstr = string to hold the converted BSTR  *)

       VAR
        ptr : POINTER TO CHAR;
        len,pos : CARDINAL;
       BEGIN
        ptr := bstr;
        len := ORD(ptr^);            (* length of string *)
        FOR pos := 0 TO len-1 DO
        INC(ADDRESS(ptr));        (* get string *)
        cstr[pos] := ptr^;
        END;
        cstr[len] := 0C;            (* tack on NULL *)
       END BSTRtoCSTR;
BEGIN
    pathptr := MPTR(cliptr^.cliSetName);    (* get address of pathname *)
    BSTRtoCSTR(dest,pathptr);        (* convert string to English *)
    RETURN pathptr;                (* return ADDRESS of BSTR *)
                        (* for later use *)
END GetCurrentDir;


PROCEDURE GetSysPath(VAR FullPath, BaseName: ARRAY OF CHAR;
             key: ARRAY OF CHAR; VAR dirtype: BOOLEAN): BOOLEAN;
VAR
    lock : FileLock;
    fib : FileInfoBlockPtr;
BEGIN
    lock := Lock(ADR(key),AccessRead);
    IF lock # 0D THEN
    IF PathName(lock,FullPath) THEN
        fib := AllocMem(SIZE(fib^),MemReqSet{MemPublic});
        IF fib # NIL THEN
            IF Examine(lock,fib^) THEN
            dirtype := IsDir(fib);
            CopyString(BaseName,fib^.fibFileName);
            FreeMem(fib,SIZE(fib^));
            UnLock(lock);
            RETURN TRUE;
        ELSE
            printf(ExamineErr,arg);
            FreeMem(fib,SIZE(fib^));
            UnLock(lock);
        END;                    (* IF Examine *)
        ELSE
            printf(MemErr,arg);
        UnLock(lock);
        END;                    (* IF fib *)
    ELSE
        printf(GeneralErr,arg);
        UnLock(lock);
    END;                        (* IF PathName *)
    ELSE
        arg := ADR(key);
        printf(LockErr,arg);
    END;                        (* IF lock *)
    RETURN FALSE;
END GetSysPath;


PROCEDURE ScanDir(fib: FileInfoBlockPtr; VAR ParentDir,
          DirName: ARRAY OF CHAR);
VAR
    lock,
    oldlock, newlock : FileLock;
    pathptr : ADDRESS;
    FullPathName : ARRAY [0..255] OF CHAR;
    first, last : DirEntry;
    ok : BOOLEAN;
BEGIN
    first := NIL;
    TackOn(FullPathName,ParentDir,DirName);

    lock := Lock(ADR(FullPathName),AccessRead);
    ok := (lock # 0D) AND Examine(lock,fib^) AND ExNext(lock,fib^);
    IF ok THEN
    WHILE ok AND NOT CtrlC() AND NOT found AND
        (IoErr() # ErrorNoMoreEntries) DO
        IF IsDir(fib) THEN
                 last := AllocMem(SIZE(last^),MemReqSet{MemPublic});
            CopyString(last^.DirName,fib^.fibFileName);
          last^.next := first;
        first := last;

        IF exactset THEN
            found := matched(fib^.fibFileName,argv^[1]^,TRUE);
        ELSE
            found := matched(fib^.fibFileName,argv^[1]^,FALSE);
        END;

        IF found THEN
            TackOn(FullPathName,FullPathName,fib^.fibFileName);
            newlock := Lock(ADR(FullPathName),AccessRead);
            IF newlock # 0D THEN
                oldlock := CurrentDir(newlock);
            UnLock(oldlock);
            pathptr := MPTR(cliptr^.cliSetName);
            SetPathName(pathptr,FullPathName);
            ELSE
                printf(GeneralErr,arg);
            END;                (* IF newlock *)
        END;                    (* IF found *)
        END;                    (* IF IsDir *)
        ok := ExNext(lock,fib^);
    END;                        (* WHILE *)

    WHILE first # NIL DO
        IF NOT CtrlC() AND NOT found THEN
        ScanDir(fib,FullPathName,first^.DirName);
        END;

        last := first;
        first := first^.next;
        FreeMem(last,SIZE(last^));
    END;
    END;
    UnLock(lock);
END ScanDir;
(*$D-*)


PROCEDURE OneArg(fib: FileInfoBlockPtr; dirname: ARRAY OF CHAR);
    (* This is more code than would be necessary if I used
       ScanDir(), but it's different enough that all the
       IF/THENs would make ScanDir() unreadable, so...  *)
VAR
    pathptr : ADDRESS;
    lock,
    newlock,oldlock : FileLock;
BEGIN
    lock := Lock(ADR(dirname),AccessRead);
    IF lock # 0D THEN
    IF Examine(lock,fib^) THEN
        IF IsDir(fib) THEN
        newlock := Lock(ADR(dirname),AccessRead);
        IF newlock # 0D THEN
            oldlock := CurrentDir(newlock);
            UnLock(oldlock);
            UnLock(lock);
            pathptr := MPTR(cliptr^.cliSetName);
            SetPathName(pathptr,dirname);
        ELSE
            printf(GeneralErr,arg);
            UnLock(lock);
        END;
        ELSE
        arg := ADR(dirname);
        printf(InvalidDeviceErr,arg);
        UnLock(lock);
        END;                    (* IF IsDir *)
    ELSE
        printf(ExamineErr,arg);
        UnLock(lock);
    END;                        (* IF Examine *)
    ELSE
        arg := ADR(dirname);
        printf(LockErr,arg);
    END;                        (* IF lock *)
END OneArg;


PROCEDURE NoArgs();
VAR
    pathptr : ADDRESS;
BEGIN
    arg := ADR(dirname);

    pathptr := GetCurrentDir(dirname);    (* pathptr not needed here *)
    printf('%s\n',arg);
END NoArgs;


PROCEDURE Init();
BEGIN
    mytask := FindTask(CurrentTask);
    processptr := ProcessPtr(mytask);
    cliptr := MPTR(processptr^.prCLI);

    fib := AllocMem(SIZE(fib^),MemReqSet{MemPublic});

    IF fib = NIL THEN
        printf(MemErr,arg);
    HALT;
    END;
END Init;


PROCEDURE ReadDir();
VAR
    fh : FileHandle;
    len : CARDINAL;
    dirtype : BOOLEAN;            (* TRUE if directory *)
BEGIN
    printf('DIR: ',arg);
    fh := Input();
    len := Read(fh,ADR(dirname),128);        (* should change to 256 *)
    IF dirname[0] = 12C THEN
    Init();
    NoArgs();
    Cleanup();
    ELSIF dirname[0] = '?' THEN
    ReadDir();
    ELSIF dirname[0] = '-' THEN
    Usage();
    ELSE
    dirname[len-1] := 0C;

    Init();
    IF GetSysPath(dirname,basename,dirname,dirtype) THEN
            IF dirtype THEN
            OneArg(fib,dirname);
        ELSE
            arg := ADR(dirname);
            printf(InvalidDeviceErr,arg);
        END;
    END;
    END;
END ReadDir;


BEGIN
    CASE argc OF
    1 : Init();
        NoArgs();
            Cleanup(); |            (* just print current dir *)

    2 : IF argv^[1]^[0] = '-' THEN
        Usage();
        ELSIF argv^[1]^[0] = '?' THEN
        printf('\t(-h for Usage)\n',arg);
        ReadDir();
        Cleanup();
        ELSE
        Init();
        IF GetSysPath(dirname,basename,argv^[1]^,dirtype) THEN
            IF dirtype THEN
                OneArg(fib,dirname);
            ELSE
                arg := ADR(dirname);
                printf(InvalidDeviceErr,arg);
            END;
        END;
        Cleanup();
        END; |
    3 : IF (CompareStringCAP(argv^[2]^,"ON") = equal) THEN
            Usage();
        END; |
    4 : IF (CompareStringCAP(argv^[2]^,"ON") = equal) THEN
            argv^[2] := argv^[3];
        END;
    ELSE
        Usage();
    END;

    Init();
    null := '';
    found := FALSE;
    exactset := FALSE;

    IF (argv^[1]^[0] = '~') THEN
    argv^[1] := ADDRESS(argv^[1]) + 1D;
    IF (argv^[1]^[0] # '~') THEN
        exactset := TRUE;
        END;
    END;

    IF GetSysPath(dirname,basename,argv^[2]^,dirtype) THEN
        IF dirtype THEN
        arg := ADR(dirname);
        printf('Searching %s',arg);
            ScanDir(fib,dirname,null);
        printf(ClearLine,arg);
        ELSE
        arg := ADR(dirname);
        printf(InvalidDeviceErr,arg);
        END;
    END;
    Cleanup();
END SD.